Garbo/Garbo.cdr/mac/hypercrd/hc2_x/case.sit/Case Products 90/stack.txt

Text File | 1991-01-18 | 22KB | 804 lines

-- stack: in
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 4
-- first background id: 5175
-- card count: 78
-- first card id: 3832
-- list block id: 5643
-- print block id: 24823
-- font table block id: 0
-- style table block id: 0
-- free block count: 7
-- free size: 41696 bytes
-- total size: 516096 bytes
-- stack block size: 20480 bytes
-- created by hypercard version: 0x00000000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x55A95A94AB54AA55
-- patterns[4]: 0xFFFFDFFBEFFBDFFF
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xFF00FF00FF00FF00
-- patterns[15]: 0x8000000000000000
-- patterns[16]: 0xC300B90820401600
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0xE0371C00F80FE000
-- patterns[25]: 0x88AAAAAAAA88AA88
-- patterns[26]: 0xC8C2109800666608
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0x4004000800200200
-- patterns[38]: 0x0084200028010000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
-- Thanks to Pat Lynch's public domain Bird Anatomy for the layout
-- of a few top level cards. The scripts are completely rewritten.
-- We try to avoid button and field scripts. To make the functionality
-- more uniform, mostly the title of buttons and fields is used to
-- indicate what they are supposed to do and here we interpret
-- the action according to what type and object is selected.
-- This gives the whole hierarchy more of a class oriented rather
-- than prototype oriented look and avoids tons of duplicated small
-- scripts.
-- See the HELP CARD for more info on how this works.
--
-- This script also contains some supporting functions that
-- are only useful in develping new stacks functioning this way.
-- Perhaps they are useful to others too. You have to call them
-- from the message window.
--
--                   Enjoy,
--                       Heinz
--                   ([e-mail], [e-mail])

on mousewithin
  get the name of the target
  if it contains "card button" then sensearea
end mousewithin

on mouseDown
  put the name of the target into tname
  if tname contains "card field" then
    if the visible of the target is true and the shiftkey is down then
      glossarysearch
    else
      put the short name of the target into tname
      if tname contains "Help" or tname is in "Methods Repository Generators Price Summary Comments Ref# Languages LifeCycle" then
        popupfield tname
      end if
    end if
  else
    if tname contains "card button" then
      if the commandkey is down then
        showbtnname
      end if
    else
      if the optionkey is down then
        allfields lock
        barf "All fields of this card locked now."
      end if
    end if
  end if
end mouseDown

on mouseUp
  -- figure whether this is an auto field button (no script but
  -- name contains "popup"
  put the name of the target into tname
  if tname contains "card button" then
    put the short name of the target into tname
    if tname contains "popup" then
      put substring(tname,7,length(tname)) into tname
      popupfield tname
    end if
  end if
end mouseUp

on showbtnname
  get the name of the target
  if it contains "card button" then
    get the short name of the target
    put it into card field "label"
    show card field "Label" at the mouseH, the mouseV-20
  end if
  wait until the mouse is up
  hide card field "label"
end showbtnname

on sensearea
  set cursor to BlinkHand.1
  wait 5
  set cursor to BlinkHand.2
  wait 5
  set cursor to BlinkHand.3
  wait 5
end sensearea

on idle
  global menu1, lastTick
  if (the ticks-lastTick) >120 then
    put the ticks into lastTick
    -- ShowMenu(menu1)
  end if
  pass idle
end idle

-- Fields: We associate fields to visible and hidden buttons
--         that pup them up. The corresponding button scripts
--         run through this function. So they may behave differently
--         during development and use. Moreover this way they may
--         use the same feel.
on popupfield afield
  if the visible of card field afield is true then
    set the locktext of card field afield to true
    set the visible of card field afield to false
    hide card field afield
    if afield is "Author'sNote" then
      set the scroll of card field afield of card "Main Menu" to 0
    end if
  else
    set the visible of card field afield to true
    -- Only go card has it : visual effect zoom out slowly
    -- so use sound to show it didn't miss this call
    -- beep
    show card field afield
    if the optionkey is Down then
      set the locktext of card field afield to false
      -- choose field tool
    else -- allow second click to bring it into normal mode
      set the locktext of card field afield to true
    end if
  end if
end popupfield

-- Transitions between cards:
-- Major cards for main menu, overview and the like: stuff that is
-- available everywhere.
-- Inside a major topic, cards behave like a separate stack of its
-- own

function hasbgbtn b
if the number of bg buttons > 0 then
  repeat with i=1 to the number of bg buttons
    put the name of bg button i into bname
    if b is in bname then return i
  end repeat
end if
return 0
end hasbgbtn

function hasbtn b
if the number of card buttons > 0 then
  repeat with i=1 to the number of card buttons
    put the name of card button i into bname
    if b is in bname then return i
  end repeat
end if
return 0
end hasbtn

on clickbtn btn
  put hasbtn(btn) into btnid
  if btnid > 0 then
    click at the loc of card button btnid
  else
    put hasbgbtn(btn) into btnid
    if btnid > 0 then
      click at the loc of bg button btnid
    else answer "Cickbtn never heard of button "& btn
  end if
end clickbtn

---------
on opendetail c
  visualiris open
  go to to card c
end opendetail

on closedetail
  visualiris close
  go back
end closedetail

on opentopic c
  -- mark current card
  visual venetian blinds
  go to card c
end opentopic

on closetopic
  visual barn door close
  go back
end closetopic

----------------------
-- Import / Export
-- This is a simple facility only, we do not attempt to get a
-- complete ASCII equivalent of a stack.
-- Field text is filled from a file into card fields
-- that are known already in the stack.
-- The syntax for import/export is this:
-- CARD: CardName
--       makes CardName the card to copy whenever a new card is
--       requested subsequently.
-- :END:
--        terminates the file
-- FieldName: MultiLineText
--        enters a multi line text into the field called FieldName.
--        If the fieldname is "Name", then a new card is created
--        by copying the current card called CardName.
-- :: comment
-- __ comment
--        starts a comment line.

function nextline
global textfile
read from file textfile until return
return it
end nextline

function substring string,substart,subend
-- ain't there a substring function in Hypertalk?
-- Here we return start,end inclusive
put "" into substr
repeat with i=substart to subend
  put character i of string into nextch
  put substr&nextch into substr
end repeat
return substr
end substring

function position ch,string,substart,subend
-- ain't there a position function in Hypertalk?
-- Here we consider start,end inclusive
put false into pos
repeat with i=substart to subend
  if character i of string is ch then
    put i into pos
    exit repeat
  end if
end repeat
return pos
end position

function stringtrim string
put length(string) into len
put 1 into strstart
put len into strend
repeat with i=1 to len
  put char i of string into ch
  if ch = space or ch = tab or ch = return then
    put i+1 into strstart
  else
    exit repeat
  end if
end repeat
put len into i
repeat
  put char i of string into ch
  if ch = space or ch = tab or ch = return then
    put i-1 into strend
    put i-1 into i
    if i < strstart then
      exit repeat
    end if
  else
    exit repeat
  end if
end repeat
if strstart <= strend then
  return substring(string,strstart,strend)
else
  return ""
end if
end stringtrim

on handleNewEntry lin,endentry
  global currentcard, currentfield
  put length(lin) into len
  put substring(lin,1,endentry-1) into entryname
  -- skip white space
  put endentry+1 into begtext
  repeat with i=begtext to len
    put character i of lin into ch
    if not ( ch = space or ch = tab ) then
      put i into begtext
      exit repeat
    end if
  end repeat
  put substring(lin,begtext,len) into entrytext
  if entryname is "CARD" then
    if entrytext is not empty then
      put entrytext into currentcard
    end if
  else
    put entryname into currentfield
  end if
  if entryname is "Name" then
    newcardrequest
  end if
  if entryname is not "CARD" then
    newfieldrequest(entrytext)
  end if
end handleNewEntry

on newcardrequest
  global currentcard,cardind
  --answer "Newcardrequest"&¤tcard
  go to card currentcard
  doMenu "Copy Card"
  doMenu "Paste Card"
  put cardind+1 into cardind
  -- allow to identify these cards by program
  set the name of this card to "Import"&cardind
  set the cantdelete of this card to false
end newcardrequest

on newfieldrequest text
  global currentfield
  --answer "New field:"&¤tfield
  --answer "1ln:"&&text
  if char 1 of text is "-" and char 2 of text is "-" then
    put "" into text
  end if
  put text into cd field currentfield
end newfieldrequest

on streamintofield lin
  global currentfield
  --answer "nln:"&&lin
  if cd field currentfield is empty then
    put lin into cd field currentfield
  else
    put cd field currentfield & return & lin into cd field currentfield
  end if
end streamintofield

on import
  global textfile
  opentextfile
  importstack
  close file textfile
  answer "Update graphics Now?" with "Later" or "Now"
  if it is "Now" then updimportcards
  answer "Trim fields?" with "Later" or "Now"
  if it is "Now" then trimimportfields
  answer "Going to renumber product card names..."
  renumprod
end import

on importupdate afield
  global textfile,currentfield,currentcard
  opentextfile
  repeat
    put nextline() into lin
    put nlines + 1 into nlines
    if lin contains ":END:" then
      answer nlines&&"lines read. Done..."
      exit repeat
    end if
    put substring(lin,1,2) into startlin
    -- comment lines
    if startlin is not "::" and startlin is not "__" then
      put length(lin) into len
      put position(":",lin,2,len) into colpos
      put position(" ",lin,2,len) into spacepos
      if colpos is not false and (spacepos is false or colpos < spacepos ) then
        handleNewEntry lin,colpos
      else
        if currentfield is not empty then
          streamintofield lin
        end if
      end if
    end if
  end repeat
  close file textfile
  if afield is "Languages" then checklanguagebuttons
  if afield is contained in "Methods Repository Generators" then
    checksupbuttons
  end if
  if afield is in "Lifecycle" then checklcbuttons
  put trimstring(cd field afield) into cd fld afield
end importupdate

on importstack
  global currentfield,currentcard,cardind
  put "Productmodel" into currentcard -- default card
  put "" into lin
  put 0 into nlines
  put 1 into cardind
  put "" into currentfield
  repeat
    put nextline() into lin
    put nlines + 1 into nlines
    if lin contains ":END:" then
      answer nlines&&"lines read. Done..."
      exit repeat
    end if
    put substring(lin,1,2) into startlin
    -- comment lines
    if startlin is not "::" and startlin is not "__" then
      put length(lin) into len
      put position(":",lin,2,len) into colpos
      put position(" ",lin,2,len) into spacepos
      if colpos is not false and (spacepos is false or colpos < spacepos ) then
        handleNewEntry lin,colpos
      else
        if currentfield is not empty then
          streamintofield lin
        end if
      end if
    end if
  end repeat
end importstack

on opentextfile
  global textfile
  if textfile is "" then
    put "CASE.textonly" into textfile
  end if
  put ("TextFile = " && textfile) into temp
  answer (temp) with "Import"
  open file textfile
end opentextfile

on trimimportfields
  repeat with i=1 to the number of cards
    go to cd i
    show message
    if the short name of this card contains "Import" then
      repeat with j=1 to the number of cd fields
        put the name of cd field j into message
        put stringtrim(cd field j) into cd field j
      end repeat
    end if
  end repeat
end trimimportfields

on export
  global textfile
  opentextfile
  exportstack
  close file textfile
end export

on extractlc
  put "" into lc
  put "" into pf
  put pf&return&line 1 of cd fld platform into pf
  put pf&return&line 2 of cd fld platform into pf
  repeat with j=3 to the number of lines in cd fld platform
    put lc&return&line j of cd fld platform into lc
  end repeat
  put stringtrim(lc) into lc
  put length(lc) into len
  if lc contains "Life cycle:" then
    put substring(lc,12,len) into lc
  end if
  put stringtrim(lc) into lc
  if char 1 of lc = "-" and char 2 of lc = "-" then put "" into lc
  if lc is not empty then put lc into cd fld LifeCycle
  put lc into message
  popupfield LifeCycle
  put stringtrim(pf) into pf
  if cd fld Platform contains "Life cycle" then
    put pf into cd fld Platform
  end if
  popupfield LifeCycle
end extractlc

-- cannot eval prop, hence allow only a few
on updgraphics
  global backgroundp
  put true into backgroundp
  repeat with i=1 to the number of cards
    go to cd i
    if the short name of this card contains "Import" then
      checklcbuttons
      --checklanguagebuttons
      --checksupportbuttons
    end if
  end repeat
  put false into backgroundp
end updgraphics

on checklanguagebuttons
  -- check the languages highlighted
  clkbtn("Pascal")
  clkbtn("'C'")
  clkbtn("C++")
  clkbtn("PL/I")
  clkbtn("Ada")
  clkbtn("Fortran")
  clkbtn("Lisp")
  clkbtn("Cobol")
  set the visible of cd field "Languages" to false
end checklanguagebuttons

on checklcbuttons
  -- check the languages highlighted
  clkbtn("Analysis")
  clkbtn("Design")
  clkbtn("Prototyping")
  clkbtn("Coding")
  clkbtn("Testing")
  clkbtn("Maintenance")
  clkbtn("Re-engineering")
  clkbtn("Planning")
  clkbtn("Cross")
  set the visible of cd field "LifeCycle" to false
end checklcbuttons

on checksupportbuttons
  -- check the languages highlighted
  clkbtn("Repository")
  clkbtn("Methods")
  clkbtn("Generators")
  set the visible of cd field "Generators" to false
  set the visible of cd field "Repository" to false
  set the visible of cd field "Methods" to false
end checksupportbuttons

on clkbtn b
  send MouseDown to cd btn b
  send MouseUp to cd btn b
end clkbtn

on doMenu which
  if which is "Help Case" then
    opentopic "Help Case"
  else if which is "References" then
    opentopic "References"
  else if which is "Glossary" then
    opentopic "Glossary"
  else if which is "Tools" then
    opentopic "Product 1"
  else pass doMenu
end doMenu

on glossarySearch
  global openField,thiscard
  set lockText of the target to false
  put the short name of the target into openField
  put the short name of this card into thiscard
  -- double click
  click at the clickLoc
  click at the clickLoc
  if the selection is empty then
    set lockText of the target to true
    exit glossarySearch
  else
    put the selection into searchWord
    set lockText of the target to true
    put searchWord & "ΓÇô" into searchString
    set lockScreen to true
    go to card "Glossary"
    find searchString in field "glossary"
    if the result is not empty then
      go card thiscard
      show card field openField
      set lockscreen to false
      set cursor to 4
      barf "Sorry," && "ΓÇ£" & searchWord & "ΓÇ¥" && "isn't listed in the Glossary"
    else
      if the result is empty then
        set lockScreen to false
      end if
    end if
  end if
end glossarySearch

on enterKey
  choose Browse tool
end enterKey

-- uniform effects solved globally
-- we distinguish tree browsing and link browsing similar to
-- the GNU Emacs info system. Tree has
--               up, down, next, previous.
-- To go down we assume there is a menu of buttons.
-- up, next, previous are similarly slots, maybe buttons of a card.
-- Links to related cards can be used by
--                    follow.
-- backward along the actual path (not the tree path)
-- is supported anyway. In order not to get into the way of
-- Hypercard ids next previous etc. are named more verbosely.

function goNextCard c
visual scroll right
go to card c
result true
end goNextCard

function goPrevCard c
visual scroll left
go to card c
result true
end goPrevCard

function goDownCard c
visual iris open
go to card c
result true
end goDownCard

function goUpCard c
visual iris open
go to card c
result true
end goUpCard

on openStack
  global popupbuttons,savelevel,backgroundp,menu1,closingstack
  put false into closingstack
  put false into backgroundp
  if the version < 1.2 then
    answer "This stack needs HyperCard version 1.2."
    set lockMessages to true
    go home
  else
    put the userlevel into savelevel
    set userLevel to 2
    hide menubar
    hide message
    set cursor to 4
    go to card "main menu"
    push card
    show card field "loading"
    set lockScreen to true
    set lockMessages to true
    show all cards
    set lockScreen to false
    set lockMessages to false
    hide card field "loading"
    show card field "Author'sNote"
    --put NewMenu("Select", "Tools","(-","Help Case","(-", --"References","Glossary") into menu1
    --if menu1 is 0 then answer("Unable to make menu 'Sections'") --with "Damn"
  end if
end openStack

on closeStack
  global closingstack
  set cursor to 4
  put true into closingstack
  visual iris close
  go to card "Main Menu"
  visual dissolve slowly
  go to card "Closing Credit"
  wait 10 seconds
  global menu1, saveLevel
  -- put DeleteMenu(menu1) into menu1
  set the userlevel to saveLevel
  show menubar
  -- reset the scrolls of the various scrollable cards
  scrollzero
end closeStack

on scrollzero
  set the scroll of card field "References" of card "References" to 0
  set the scroll of card field "Glossary" of card "Glossary" to 0
  set the scroll of card field "Author'sNote" of card "Main Menu" to 0
end scrollzero

on allFields what
  if number of card fields > 0 then
    repeat with i=1 to the number of card fields
      if what = "show" then
        set the visible of card field i to true
        set the locktext of card field i to false
        show card field i
      else if what = "lock" then
        set the locktext of card field i to true
      else if what = "unlock" then
        set the locktext of card field i to false
      else if what = "hide" then
        set the visible of card field i to false
      else barf "allFields unknown option: " & what & " (ctl-.)"
    end repeat
  else barf "No fields on this card"
end allFields

on chgaprop afield,prop,val
  repeat with i=1 to the number of cards
    go to card i
    if the short name of this card contains "Product" then
      set the visible of cd fld afield to true
      -- cannot eval prop, hence allow only a few
      if prop = "width" then
        set the width of cd fld afield to val
      else if prop = "height" then
        set the height of cd fld afield to val
      else if prop = "script" then
        set the script of cd fld afield to val
      else if prop = "style" then
        set the style of cd fld afield to val
      else if prop = "locktext" then
        set the locktext of cd fld afield to val
      else if prop = "loc" then
        set the loc of cd fld afield to val
      else if prop = "textfont" then
        set the textfont of cd fld afield to val
      else if prop = "textstyle" then
        set the textstyle of cd fld afield to val
      else if prop = "visible" then
        set the visible of cd fld afield to val
      else if prop = "textsize" then
        set the textsize of cd fld afield to val
      else
        answer "chgaprop cannot support set"&&prop
      end if
      -- set the prop of cd field afield to fon
    end if
  end repeat
  answer "Done..."
end chgaprop

on chgabtn fromb,tob
  repeat with i=1 to the number of cards
    go to card i
    if the short name of this card contains "Product" then
      if hasbtn(fromb) <> 0 then
        set the name of cd btn fromb to tob
      end if
    end if
  end repeat
  answer "Done..."
end chgabtn

on renumprod
  put 1 into ind
  repeat with i=1 to the number of cards
    go to card i
    show message
    if the short name of this card contains "Product" and the short name of this card is not "Productmodel" then
      set the name of this card to "Product"&&ind
      put ind + 1 into ind
    end if
  end repeat
  answer "Done..."
end renumprod

on barf mess
  show message
  put mess into message
  play boing
  wait 4 seconds
  hide message
end barf